VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsStatus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'-----------------------------------------------------------------
'             PT DC Hub @ Direct Connect P2P Network
'-----------------------------------------------------------------
'       Developer: Carlos.DF (fLaSh) - Portugal
'          E-mail: carlosferreiracarlos@hotmail.com
' Project started: 10 - September - 2006
'         License: GNU General Public License.
'-----------------------------------------------------------------
'       Thanks to developers and contributores of SDCH/DDCH
'         The Left Hand, ButterflySoul, HaArD and Selyb
'  TheNOP, RollTheDice, JDommi, GhOstFaCE, ArchaicLight and TUFF
'-----------------------------------------------------------------
Option Explicit

#If Status Then
    'Protocol '*************************
    Public NickList             As Long
    Public ConnectMe            As Long
    Public RevConnectToMe       As Long
    Public Kicks                As Long
    Public Redirects            As Long
    Public BotINFO              As Long
    Public NetInfo              As Long
    Public Errors               As Long
    Public ErrSockets           As Long
    Public Requests             As Long
    '***********************************
    
    'Traffic ****************************
    Public MsgMainChat          As Long
    Public MsgPM                As Long
    Public Searchs              As Long
    Public MyINFOs              As Long
    Public TotalSent            As Long
    Public TotalReceived        As Long
    '
    Private SpeedSend           As Long
    Private SpeedRecived        As Long
    '***********************************
    
    Public Enum enSatistics
        iProtocol = 0
        iTraffic = 1
    End Enum
    
    Public Enum enProtocol
        iNickList = 0
        iConnectMe = 1
        iRevConnectToMe = 2
        iKicks = 3
        iRedirects = 4
        iBotINFO = 5
        iNetINFO = 6
        iErrors = 7
        iErrSockets = 8
        iRequests = 9
    End Enum
    
    Public Enum enTraffic
        iMsgMainChat = 0
        iMsgPM = 1
        iSearchs = 2
        iMyINFOs = 3
        iTotalSent = 4
        iTotalReceived = 5
    End Enum
    
    Private WithEvents m_Timer           As Timer
Attribute m_Timer.VB_VarHelpID = -1
    Private m_frmParent                  As frmParent
    
    'Logs  *****************************************************************
    Private m_lvwUsers                    As Variant
    Private m_lvwItem                     As Variant
    Private m_objSciLog(2)                As clsYScintilla
    '*********************************************************************
    
    'Statistics ***********************************************************
    Private m_lblProtocol(9)              As Label
    Private m_lblTraffic(7)               As Label
    '*********************************************************************
    
    Private Sub Class_Initialize()
1:        Set m_lvwUsers = frmHub.lvwUsers.ListItems
2:        Set m_objSciLog(0) = frmHub.oSciLog(0)
3:        Set m_objSciLog(1) = frmHub.oSciLog(1)
4:        Set m_objSciLog(2) = frmHub.oSciLog(2)
5:        Set m_lblProtocol(0) = frmHub.lblStatistics(0)
6:        Set m_lblProtocol(1) = frmHub.lblStatistics(1)
7:        Set m_lblProtocol(2) = frmHub.lblStatistics(2)
8:        Set m_lblProtocol(3) = frmHub.lblStatistics(3)
9:        Set m_lblProtocol(4) = frmHub.lblStatistics(4)
10:       Set m_lblProtocol(5) = frmHub.lblStatistics(5)
11:       Set m_lblProtocol(6) = frmHub.lblStatistics(6)
12:       Set m_lblProtocol(7) = frmHub.lblStatistics(7)
13:       Set m_lblProtocol(8) = frmHub.lblStatistics(8)
14:       Set m_lblProtocol(9) = frmHub.lblStatistics(9)
15:       Set m_lblTraffic(0) = frmHub.lblStatistics(20)
16:       Set m_lblTraffic(1) = frmHub.lblStatistics(21)
17:       Set m_lblTraffic(2) = frmHub.lblStatistics(22)
18:       Set m_lblTraffic(3) = frmHub.lblStatistics(23)
19:       Set m_lblTraffic(4) = frmHub.lblStatistics(24)
20:       Set m_lblTraffic(5) = frmHub.lblStatistics(25)
21:       Set m_lblTraffic(6) = frmHub.lblStatistics(26)
22:       Set m_lblTraffic(7) = frmHub.lblStatistics(27)
          'Create our dummy form to get it's Timer
24:       Set m_frmParent = New frmParent
25:       Set m_Timer = m_frmParent.tmrTimer
26:       m_Timer.Interval = 1000
27:       m_Timer.Enabled = True
28:       ClearStatistics
    End Sub
    
    Private Sub Class_Terminate()
1:        m_Timer.Enabled = False
2:        Set m_Timer = Nothing
3:        Set m_frmParent = Nothing
4:        Set m_lvwUsers = Nothing
5:        Set m_objSciLog(0) = Nothing
6:        Set m_objSciLog(1) = Nothing
7:        Set m_objSciLog(2) = Nothing
    End Sub
    
    Public Sub ClearStatistics()
1:       On Error GoTo Err

         'Protocol
4:       NickList = 0
5:       ConnectMe = 0
6:       RevConnectToMe = 0
7:       Kicks = 0
8:       Redirects = 0
9:       BotINFO = 0
10:      NetInfo = 0
11:      Errors = 0
12:      ErrSockets = 0
13:      Requests = 0

         'Traffic
16:      MsgMainChat = 0
17:      MsgPM = 0
18:      Searchs = 0
19:      MyINFOs = 0
20:      TotalSent = 0
21:      TotalReceived = 0

23:      SpeedSend = 0
24:      SpeedRecived = 0

26:      RefreshLvw iProtocol
27:      RefreshLvw iTraffic

29:      If Not g_objSettings.EnabledStatistics Then
30:         m_lblTraffic(6).Caption = "0 Kb/s"
31:         m_lblTraffic(7).Caption = "0 Kb/s"
32:      End If

34:      Exit Sub
35:
Err:
36:      HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.ClearStatistics()"
    End Sub

    Public Sub UpDateProtocol(ByVal typ As enProtocol)
1:       On Error GoTo Err
    
3:       If Not g_objSettings.EnabledStatistics Then Exit Sub
        
         Select Case typ
            Case 0: NickList = NickList + 1
            Case 1: ConnectMe = ConnectMe + 1
            Case 2: RevConnectToMe = RevConnectToMe + 1
            Case 3: Kicks = Kicks + 1
            Case 4: Redirects = Redirects + 1
            Case 5: BotINFO = BotINFO + 1
            Case 6: NetInfo = NetInfo + 1
            Case 7: Errors = Errors + 1
            Case 8: ErrSockets = ErrSockets + 1
            Case 9: Requests = Requests + 1
5:       End Select
 
7:       RefreshLvw iProtocol

9:       Exit Sub
10:
Err:
11:      HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.UpDateProtocol(" & typ & ")"
    End Sub

    Public Sub UpDateTraffic(ByVal lngValue As Long, ByVal typ As enTraffic)
1:       On Error GoTo Err

3:       If Not g_objSettings.EnabledStatistics Then Exit Sub
        
         Select Case typ
            Case 0: MsgMainChat = MsgMainChat + lngValue
            Case 1: MsgPM = MsgPM + lngValue
            Case 2: Searchs = Searchs + lngValue
            Case 3: MyINFOs = MyINFOs + lngValue
            Case 4: TotalSent = TotalSent + lngValue: SpeedSend = lngValue
            Case 5: TotalReceived = TotalReceived + lngValue: SpeedRecived = lngValue
5:       End Select
 
7:       RefreshLvw iTraffic

9:       Exit Sub
10:
Err:
11:      HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.UpDateTraffic(" & lngValue & ", " & typ & ")"
    End Sub
    
    Public Sub RefreshLvw(ByVal enu As enSatistics)
1:        On Error GoTo Err

          Select Case enu
    
            '************************
            Case iProtocol
            '************************
            
7:             m_lblProtocol(0).Caption = CStr(NickList)
8:             m_lblProtocol(1).Caption = CStr(ConnectMe)
9:             m_lblProtocol(2).Caption = CStr(RevConnectToMe)
10:            m_lblProtocol(3).Caption = CStr(Kicks)
11:            m_lblProtocol(4).Caption = CStr(Redirects)
12:            m_lblProtocol(5).Caption = CStr(BotINFO)
13:            m_lblProtocol(6).Caption = CStr(NetInfo)
14:            m_lblProtocol(7).Caption = CStr(Errors)
15:            m_lblProtocol(8).Caption = CStr(ErrSockets)
16:            m_lblProtocol(9).Caption = CStr(Requests)

            '************************
            Case iTraffic
            '************************
               
21:            m_lblTraffic(0).Caption = ConverteSize(MsgMainChat)
22:            m_lblTraffic(1).Caption = ConverteSize(MsgPM)
23:            m_lblTraffic(2).Caption = ConverteSize(Searchs)
24:            m_lblTraffic(3).Caption = ConverteSize(MyINFOs)
25:            m_lblTraffic(4).Caption = ConverteSize(TotalSent)
26:            m_lblTraffic(5).Caption = ConverteSize(TotalReceived)

28:         End Select

30:      Exit Sub
31:
Err:
32:      HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.RefreshLvw(" & enu & ")"
    End Sub

    Private Function GetSpeed(ByVal dblBytes As Long) As String
1:       On Error Resume Next
2:       GetSpeed = FormatNumber(dblBytes / 1024, 3) & " Kb/s"
    End Function
    
    'Create a nice balance ;-)
    Private Sub m_Timer_Timer()
1:      On Error GoTo Err

3:      If Not g_objSettings.EnabledStatistics Then Exit Sub

5:      If SpeedSend > 0 Then
6:          m_lblTraffic(6).Caption = GetSpeed(CDbl(SpeedSend))
7:          If SpeedSend <= 10 Then m_lblTraffic(6).Caption = "0 Kb/s"
8:      End If
        
10:     If SpeedSend > 0 Then
11:         m_lblTraffic(7).Caption = GetSpeed(CDbl(SpeedRecived))
12:         If SpeedRecived <= 10 Then m_lblTraffic(7).Caption = "0 Kb/s"
13:     End If
 
15:     If SpeedSend > 0 Then SpeedSend = SpeedSend - 10 'Bytes
16:     If SpeedRecived > 0 Then SpeedRecived = SpeedSend - 10 'Bytes

18:     If SpeedSend < 0 Then SpeedSend = 0
19:     If SpeedRecived < 0 Then SpeedRecived = 0

21:     Exit Sub
22:
Err:
23:     HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.m_Timer_Timer()"
    End Sub
    
    'Determines the closest size in the approriate *B
    Private Function ConverteSize(ByVal dblBytes As Double) As String
1:      On Error GoTo Err
         
        Select Case dblBytes
            Case Is > 1048575
3:                ConverteSize = FormatNumber(dblBytes / 1048576, 2) & " MiB"
            Case Is > 1023
4:                ConverteSize = FormatNumber(dblBytes / 1024, 2) & " KiB"
            Case Else
5:                ConverteSize = dblBytes & " Bytes"
6:      End Select
        
8:      Exit Function
9:
Err:
10:     HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.ShareSize(" & dblBytes & ")"
    End Function
    
    'Adds a user to the listview
    Public Sub UAdd(ByVal oUser As clsUser)
3:        On Error GoTo Err

          'Add listitem with unknown icon
8:        Set m_lvwItem = m_lvwUsers.Add(, CStr(oUser.iWinsockIndex) & "s", "(No name)")
        
          'Add extra info
11:       m_lvwItem.SubItems(1) = oUser.IP
12:       m_lvwItem.SubItems(11) = CStr(oUser.iWinsockIndex)
13:       m_lvwItem.SubItems(12) = CStr(oUser.ConnectedSince)
      
15:       Set m_lvwItem = Nothing
        
17:       Exit Sub
19:
Err:
20:       HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.UAdd()"
    End Sub
    
    'Updates a users info
    Public Sub UUpdate(ByVal oUser As clsUser)
4:         On Error Resume Next
5:         Set m_lvwItem = m_lvwUsers.Item(CStr(oUser.iWinsockIndex & "s"))
6:         If (Err.Number = 0) And (LenB(oUser.sName) > 0) Then
7:             On Error GoTo Err
8:             m_lvwItem.Text = oUser.sName
9:             m_lvwItem.SubItems(1) = oUser.IP
10:            m_lvwItem.SubItems(2) = g_objFunctions.ClassName(CInt(oUser.Class))
11:            m_lvwItem.SubItems(3) = g_objFunctions.ShareSize(oUser.iBytesShared)
12:            m_lvwItem.SubItems(4) = oUser.MyINFO(eDescription)
13:            m_lvwItem.SubItems(5) = oUser.MyINFO(eTag)
14:            m_lvwItem.SubItems(6) = oUser.MyINFO(eConnection)
15:            m_lvwItem.SubItems(7) = oUser.MyINFO(eEmail)
16:            m_lvwItem.SubItems(8) = oUser.MyINFO(eClient) & " V:" & oUser.MyINFO(eVersion)
17:            m_lvwItem.SubItems(9) = CStr(oUser.MyINFO(eHubsCount) & "(" & oUser.MyINFO(eHubsUnReg) & "/" & oUser.MyINFO(eHubsReg) & "/" & oUser.MyINFO(eHubsOp) & ")")
18:            m_lvwItem.SubItems(10) = CStr(oUser.MyINFO(eSlots))
19:            m_lvwItem.SubItems(11) = CStr(oUser.iWinsockIndex)
20:            m_lvwItem.SubItems(12) = CStr(oUser.ConnectedSince)
            m_lvwItem.SubItems(13) = oUser.sMyInfoString
            m_lvwItem.SubItems(14) = oUser.Supports
            m_lvwItem.SubItems(15) = CStr(oUser.iVersion)
22:        End If
23:        Exit Sub
24:
Err:
25:        HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.UUpdate(" & oUser.sName & ")"
    End Sub

    'Removes a user from the listview
    Public Sub URemove(ByVal intIndex As Integer)
1:       On Error GoTo Err
3:       m_lvwUsers.Remove intIndex & "s"
5:       Exit Sub
6:
Err:
7:       HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.URemove()"
    End Sub
    
    'Adds a message to the message listbox
    Public Sub MAdd(ByVal strMessage As String)
1:      On Error GoTo Err
2:      Dim sTemp As String

       'PM Log
5:      If Mid(strMessage, 1, 4) = "$To:" Then
6:             sTemp = g_objFunctions.NMDCUnescape(strMessage)
7:             AddLog sTemp, m_objSciLog(1)
8:             If g_objSettings.LogPM Then
9:                  g_objFileAccess.AppendFile G_APPPATH & "\Logs\PM.log", "[" & Now & "]" & sTemp
10:            End If
        'Main Chat Log
12:     ElseIf Mid(strMessage, 1, 1) = "<" Then
13:            sTemp = g_objFunctions.NMDCUnescape(strMessage)
14:            AddLog sTemp, m_objSciLog(0)
15:            If g_objSettings.LogMC Then
16:                  g_objFileAccess.AppendFile G_APPPATH & "\Logs\MC.log", "[" & Now & "]" & sTemp
17:            End If
        'Misc protocol log
19:     Else
20:            If EnabledMiscLog Then
21:                  AddLog strMessage, m_objSciLog(2), False
22:            End If
23:     End If
24:
Err:
25:     HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.MAdd(" & strMessage & ")"
    End Sub
    
    'Clears all messages
    Public Sub MClear(ByVal iIndex As Integer)
1:      On Error GoTo Err
2:      m_objSciLog(iIndex).ReadOnly = False
3:      m_objSciLog(iIndex).Text = ""
4:      m_objSciLog(iIndex).ReadOnly = True
5:      Exit Sub
6:
Err:
7:      HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.MClear(" & iIndex & ")"
    End Sub
    
    'Clears m_lvwUsers
    Public Sub UClear()
1:        On Error GoTo Err
2:        m_lvwUsers.Clear
3:        Exit Sub
4:
Err:
5:        HandleError Err.Number, Err.Description, Erl & "|" & "clsStatus.UClear()"
    End Sub
   
    'This function will be for little memory..
    'It is not necessary to generate the log, if the listbox is not visible
    'this because this log use a lot of memory..
    Private Function EnabledMiscLog() As Boolean
1:        If frmHub.WindowState = vbMinimized Or _
             frmHub.picStatus(2).Visible = False Then _
               EnabledMiscLog = False _
          Else EnabledMiscLog = True
    End Function
    
    'This function will be for little memory..
    'It is not necessary to generate the info, if the picture box is not visible
    'this because this log use a lot of memory..
    Private Function EnabledStatistics() As Boolean
1:        If frmHub.WindowState = vbMinimized Or _
                 frmHub.picStatus(5).Visible = False Then _
               EnabledStatistics = False _
          Else EnabledStatistics = True
    End Function
#End If


